home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / auto / RPC / XML / Server / dispatch.al < prev    next >
Encoding:
Text File  |  2008-11-04  |  2.8 KB  |  82 lines
  1. # NOTE: Derived from blib/lib/RPC/XML/Server.pm.
  2. # Changes made here will be lost when autosplit is run again.
  3. # See AutoSplit.pm.
  4. package RPC::XML::Server;
  5.  
  6. #line 1660 "blib/lib/RPC/XML/Server.pm (autosplit into blib/lib/auto/RPC/XML/Server/dispatch.al)"
  7. ###############################################################################
  8. #
  9. #   Sub Name:       dispatch
  10. #
  11. #   Description:    Route the request by parsing it, determining what the
  12. #                   Perl routine should be, etc.
  13. #
  14. #   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
  15. #                   $self     in      ref       Object of this class
  16. #                   $xml      in      ref       Reference to the XML text, or
  17. #                                                 a RPC::XML::request object.
  18. #                                                 If it is a listref, assume
  19. #                                                 [ name, @args ].
  20. #                   $reftable in      hashref   If present, a reference to the
  21. #                                                 current-running table of
  22. #                                                 back-references
  23. #
  24. #   Returns:        RPC::XML::response object
  25. #
  26. ###############################################################################
  27. sub dispatch
  28. {
  29.     my ($self, $xml) = @_;
  30.  
  31.     my ($reqobj, @data, $response, $name, $meth);
  32.  
  33.     if (ref($xml) eq 'SCALAR')
  34.     {
  35.         $reqobj = $self->parser->parse($$xml);
  36.         return RPC::XML::response
  37.             ->new(RPC::XML::fault->new(200, "XML parse failure: $reqobj"))
  38.                 unless (ref $reqobj);
  39.     }
  40.     elsif (ref($xml) eq 'ARRAY')
  41.     {
  42.         # This is sort of a cheat, to make the system.multicall API call a
  43.         # lot easier. The syntax isn't documented in the manual page, for good
  44.         # reason.
  45.         $reqobj = RPC::XML::request->new(shift(@$xml), @$xml);
  46.     }
  47.     elsif (ref($xml) and $xml->isa('RPC::XML::request'))
  48.     {
  49.         $reqobj = $xml;
  50.     }
  51.     else
  52.     {
  53.         $reqobj = $self->parser->parse($xml);
  54.         return RPC::XML::response
  55.             ->new(RPC::XML::fault->new(200, "XML parse failure: $reqobj"))
  56.                 unless (ref $reqobj);
  57.     }
  58.  
  59.     @data = @{$reqobj->args};
  60.     $name = $reqobj->name;
  61.  
  62.     # Get the method, call it, and bump the internal requests counter. Create
  63.     # a fault object if there is problem with the method object itself.
  64.     if (ref($meth = $self->get_method($name)))
  65.     {
  66.         $response = $meth->call($self, @data);
  67.         $self->{__requests}++
  68.             unless (($name eq 'system.status') && @data &&
  69.                     ($data[0]->type eq 'boolean') && ($data[0]->value));
  70.     }
  71.     else
  72.     {
  73.         $response = RPC::XML::fault->new(300, $meth);
  74.     }
  75.  
  76.     # All the eval'ing and error-trapping happened within the method class
  77.     RPC::XML::response->new($response);
  78. }
  79.  
  80. # end of RPC::XML::Server::dispatch
  81. 1;
  82.